home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PBLIB1
/
UNITS
/
PBOUT1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-03
|
10KB
|
413 lines
{SECTION ..PbOUT1 }
UNIT PbOUT1;
INTERFACE
uses PbMISC, PbDATA, PbOBJS, PbPARMS;
{
Description : Medium level Use of OUT_object
Author : Howard Richoux
Date : 12/24/93
Last revised: 2/18/94 changed libraries
Application : IBM PC and compatibles, done in Turbo Pascal 7
Status : Placed in the Public Domain by HNR Software 1/29/1994
Published in: none
OUT is a shell around the OUT_object so that calling
programs don't have to worry about a lot of the details. They
also don't get much control, just the pre-open variables set
in the program and through PARMS.
Through the variables are options for CON/LPT1/file output,
compressed & landscape printing, headers and footers.
Use is:
StandardOUTInit;
...
OUT(<string>);
...
OUTdone;
}
var pCompressed : boolean;
var pLandscape : boolean;
var pHeader1 : string[50];
var pHeader2 : string[30];
var pHeader3 : string[30];
var pFooter1 : string[30];
var pFooter2 : string[50];
var pPageLabel1 : string[30];
var pPageLabel2 : string[30];
var pPageLabel3 : string[30];
Procedure OUT(s:string);
{[OUT] Outputs a string }
Procedure OUTChangeAPPEND(fn : string);
{[OUT] Closes current output file/dev opens a new one APPEND }
Procedure OUTChangeREWRITE(fn : string);
{[OUT] Closes current output file/dev opens a new one CLEARING contents }
Function OUTcompressed : boolean;
{[OUT] Returns true if output compressed }
Function OUTCurrentLineLen : integer;
{[OUT] Returns current line length }
Function OUTcurrentPage : integer;
{[OUT] Returns current page number }
Procedure OUTdone;
{[OUT] Closes output device }
Procedure OUTdoneWithPage;
{[OUT] Next line will go on new page }
Procedure OUTFlushJoin(alldone : boolean);
{[OUT*] Get out of word wrap mode }
Procedure OUTJoin(s:string);
{[OUT*] Outputs a string word wrap if necessary}
Function OUTJoinStatus : boolean;
{[OUT*] returns state of the joinflag}
Function OUTLinesLeft : integer;
{[OUT] lines left on current page }
Procedure OUTNoCR(s:string);
{[OUT] Outputs a string - NO CR/LF }
Procedure OUTSetCompressed;
{[OUT] Go to Compressed print }
Procedure OUTSetHeaders(h1,h2,h3,f1,f2 : string);
{[OUT*] Sets the headers and footers }
Procedure OUTSetIndent( i : integer);
{[OUT] Extra left space }
Procedure OUTSetJoin;
{[OUT*] Go to line word wrap mode }
Procedure OUTSetJoinWidth(w : integer);
{[OUT*] Set the word wrap line width }
Procedure OUTSetLandscape;
{[OUT] Go to Landscape Mode }
Procedure OUTSetLengths(ll,pl : integer);
{[OUT] Manual override to linelen and pagelen }
Procedure OUTSetNoPause;
{[OUT] Cancels pausing on CRT output }
Procedure OUTSetNoPrint;
{[OUT] Suppress output, keep bookkeeping }
Procedure OUTSetPageLabels(p1,p2,p3 : string);
{[OUT*] Sets the optional strings }
Procedure OUTSetPrint;
{[OUT] Turn printing back on. }
Procedure OUTPause;
{[OUT] Pauses if CRT output. }
Procedure StandardOUTInit;
{[OUT] Support for PbOUT; calls StandardpVarsInit }
{ extra utility procs using PbOUT1 basic calls }
Procedure OUTDOSErr(s : string; e : integer);
{[OUT] Outputs a line containing the DOS error message}
{SECTION .ZImplementation }
IMPLEMENTATION
var Outp : OUT_object_1; { All access to Outp via PbOUT calls }
{SECTION AddOUTpVars }
Procedure AddOUTpVars;
begin
AddParm(1,'COMPRESSED','NO');
AddParm(1,'LANDSCAPE','NO');
AddParm(1,'HEADER1','@DATE|@PROGID|');
AddParm(1,'HEADER2',' ');
AddParm(1,'HEADER3','');
AddParm(1,'FOOTER1','');
AddParm(1,'FOOTER2','');
AddParm(1,'LABEL1','');
AddParm(1,'LABEL2','');
AddParm(1,'LABEL3','');
end;
{SECTION GetOUTpVars }
Procedure GetOUTpVars;
begin
pCompressed := CheckOK('COMPRESSED');
pLandscape := CheckOK('LANDSCAPE');
pHeader1 := GetParmStr('HEADER1');
pHeader2 := GetParmStr('HEADER2');
pHeader3 := GetParmStr('HEADER3');
pFooter1 := GetParmStr('FOOTER1');
pFooter2 := GetParmStr('FOOTER2');
pPageLabel1 := GetParmStr('LABEL1');
pPageLabel2 := GetParmStr('LABEL2');
pPageLabel3 := GetParmStr('LABEL3');
end;
{SECTION OUT }
Procedure OUT(s:string);
begin
{ writeln('** ',s,' ** ',outp.llen,' ',outp.currllen,' ',outp.loff,' ',outp.indent);}
Outp.out(s);
end;
{SECTION OUTChangeAPPEND }
Procedure OUTChangeAPPEND(fn : string);
{[OUT] Closes current output file/dev opens a new one APPEND }
begin
Outp.done;
pOutFile := fn;
OUTp.LISTinit(pOutFile,OUT_typAPPEND);
if pCompressed then OUTp.SetCompressed;
if pLandscape then OUTp.SetLandscape;
OUTp.LISTopen;
end;
{SECTION OUTChangeREWRITE }
Procedure OUTChangeREWRITE(fn : string);
{[OUT] Closes current output file/dev opens a new one CLEARING contents }
begin
Outp.done;
pOutFile := fn;
OUTp.LISTinit(pOutFile,OUT_typREWRITE);
if pCompressed then OUTp.SetCompressed;
if pLandscape then OUTp.SetLandscape;
OUTp.LISTopen;
end;
{SECTION OUTCompressed }
FunctION OUTCompressed : boolean;
begin
OUTCompressed := Outp.compressed;
end;
{SECTION OUTCurrentLineLen }
Function OUTCurrentLineLen : integer;
begin
OUTCurrentLineLen := Outp.currllen;
end;
{SECTION OUTCurrentPage }
Function OUTCurrentPage : integer;
begin
OUTCurrentPage := Outp.currpage;
end;
{SECTION OUTdone }
Procedure OUTdone;
begin
Outp.done;
end;
{SECTION OUTdonewithPage }
Procedure OUTdoneWithPage;
begin
Outp.DoneWithPage;
end;
{SECTION OUTFlushJoin }
Procedure OUTFlushJoin(alldone : boolean);
begin
Outp.flushjoin(alldone);
end;
{SECTION OUTJoin }
Procedure OUTJoin(s:string);
begin
Outp.outjoin(s);
end;
{SECTION OUTLinesLeft }
Function OUTLinesLeft : integer;
{[OUT] lines left on current page }
begin
OUTLinesLeft := (Outp.plen - Outp.currline) + 1;
end;
{SECTION OUTNoCR }
Procedure OUTNoCR(s:string);
begin
Outp.outERRNoCR(s); { no CR/LF and no bookkeeping }
end;
{SECTION OUTPause }
Procedure OUTPause;
begin
Outp.pause;
end;
{SECTION OUTSetHeaders }
Procedure OUTSetHeaders(h1,h2,h3,f1,f2 : string);
begin
Outp.SetHeaders(h1,h2,h3,f1,f2);
end;
{SECTION OUTSetCompressed }
Procedure OUTSetCompressed;
begin
Outp.SetCompressed;
end;
{SECTION OUTSetIndent }
Procedure OUTSetIndent( i : integer);
begin
Outp.SetIndent(i);
end;
{SECTION OUTSetJoin }
Procedure OUTSetJoin;
begin
Outp.joinflag := true;
end;
{SECTION OUTSetJoin }
Function OUTJoinStatus : boolean;
begin
OutJoinStatus := Outp.joinflag;
end;
{SECTION OUTSetJoinWidth }
Procedure OUTSetJoinWidth(w : integer);
begin
if w = 0 then Outp.joinwidth := Outp.currllen
else Outp.joinwidth := w;
end;
{SECTION OUTSetLandscape }
Procedure OUTSetLandscape;
begin
Outp.SetLandscape;
end;
{SECTION OUTSetLengths }
Procedure OUTSetLengths(ll,pl : integer);
begin
Outp.llen := ll;
Outp.plen := pl;
end;
{SECTION OUTSetNoPause }
Procedure OUTSetNoPause;
begin
Outp.SetNoPause;
end;
{SECTION OUTSetNoPrint }
Procedure OUTSetNoPrint;
begin
Outp.noprint := true;
end;
{SECTION OUTSetPageLabels }
Procedure OUTSetPageLabels(p1,p2,p3 : string);
begin
Outp.pagelabel1 := p1;
Outp.pagelabel2 := p2;
Outp.pagelabel3 := p3;
end;
{SECTION OUTSetPrint }
Procedure OUTSetPrint;
begin
Outp.noprint := false;
end;
{SECTION StandardOutINit }
Procedure StandardOUTInit;
begin
StandardpVarsInit; { Picks up the other pVars as well }
GetOUTpVars; { OUT specific pVars }
if ScanParms('P') then pOutFile := 'LPT1';
OUTp.LISTinit(pOutFile,OUT_typAPPEND);
if OUTp.devtyp =OUT_typCRT then
begin {CRT is cranked down to nothing }
OUTp.SetHeaders('','','','','');
end
else OUTp.SetHeaders(pHeader1,pHeader2,pHeader3,pFooter1,pFooter2);
if pCompressed then OUTp.SetCompressed;
if pLandscape then OUTp.SetLandscape;
OUTp.LISTopen;
end;
{SECTION OUTDOSErr }
Procedure OUTDOSErr(s : string; e : integer);
{[OUT] Outputs a line containing the DOS error message}
begin
OUT(s+' '+DOSErrStr(e));
end;
{SECTION zPbOUTINit_1 }
Procedure zPbOUTInit_1;
begin
pCompressed := false;
pLandscape := false;
pHeader1 := '';
pHeader2 := '';
pHeader3 := '';
pFooter1 := '';
pFooter2 := '';
AddOUTpVars; { OUT specific pVars - this makes sure calling
programs can override headers & footers }
end;
{SECTION zzInitialization }
begin {initialization}
zPbOUTInit_1;
end.